home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbfsu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  5.8 KB  |  182 lines
  1. (*===========================================================================*)
  2. (* File subsystem -- Upload file                                             *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989 by H. Roy Engehausen.  All rights reserved.        *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. {$O+}
  9.  
  10. UNIT BBFSU;
  11.  
  12. INTERFACE
  13.  
  14. PROCEDURE upload_file_cmd(cmd_string : STRING);
  15.  
  16. IMPLEMENTATION
  17.  
  18. USES
  19.   DOS,
  20.   bbcopy,
  21.   bbdummy,
  22.   bbfin,
  23.   bbfsm,
  24.   bbmdata,
  25.   bbmess,
  26.   bbmisc,
  27.   bbmisc5,
  28.   bbsdata,
  29.   bbstr;
  30.  
  31. PROCEDURE upload_file_cmd(cmd_string : STRING);
  32.  
  33.   VAR
  34.     code          : INTEGER;
  35.     dir_to_search : fsb_name_str;
  36.     i             : WORD;
  37.     in_f          : file_name_str;
  38.     look          : SEARCHREC;
  39.     search_arg    : file_name_str;
  40.     this_fsb      : fsb_ptr;
  41.     this_msg      : msg_index_ptr;
  42.     word_count    : BYTE;
  43.  
  44.   {$I BBFSI.PAS}
  45.  
  46.   BEGIN;
  47.  
  48.     (*-----------------------------------------------------------------------*)
  49.     (* Parse command and execute right routine                               *)
  50.     (*-----------------------------------------------------------------------*)
  51.  
  52.     IF cmd_string[2] <> ' ' THEN
  53.       BEGIN;
  54.         send_message(message_err_2nd);
  55.         active_tcb^.error_sw := TRUE;
  56.         EXIT;
  57.       END;
  58.  
  59.     upcase_str_var(cmd_string);
  60.  
  61.     word_count := words(cmd_string);
  62.  
  63.     IF word_count <> 3 THEN
  64.       BEGIN;
  65.         IF word_count < 3 THEN
  66.           send_message(message_not_en)
  67.         ELSE
  68.           send_message(message_err_wrd);
  69.         active_tcb^.error_sw := TRUE;
  70.         EXIT;
  71.       END;
  72.  
  73.     (*-----------------------------------------------------------------------*)
  74.     (* Parse                                                                 *)
  75.     (*-----------------------------------------------------------------------*)
  76.  
  77.     dir_to_search := subwordl(cmd_string, 2, SIZEOF(fsb_name_str) - 1);
  78.  
  79.     search_arg    := subwordl(cmd_string, 3, SIZEOF(search_arg)   - 1);
  80.  
  81.     (*-----------------------------------------------------------------------*)
  82.     (* Find the directory                                                    *)
  83.     (*-----------------------------------------------------------------------*)
  84.  
  85.     this_fsb := find_fsb(dir_to_search);
  86.  
  87.     IF (this_fsb = NIL) OR
  88.                    (active_tcb^.uid_data.user_class < this_fsb^.fsb_up) THEN
  89.       BEGIN;
  90.         send_message(message_no_files_one);
  91.         active_tcb^.error_sw := TRUE;
  92.         EXIT;
  93.       END;
  94.  
  95.     (*-----------------------------------------------------------------------*)
  96.     (* Check for subdirectory                                                *)
  97.     (*-----------------------------------------------------------------------*)
  98.  
  99.     IF (POS('\', search_arg) > 0) AND this_fsb^.fsb_f_subdir_ok THEN
  100.       BEGIN;
  101.         send_message(message_no_slash);
  102.         active_tcb^.error_sw := TRUE;
  103.         EXIT;
  104.       END;
  105.  
  106.     (*-----------------------------------------------------------------------*)
  107.     (* Check for wildcards                                                   *)
  108.     (*-----------------------------------------------------------------------*)
  109.  
  110.     IF (POS('*', search_arg) > 0) THEN
  111.       BEGIN;
  112.         send_message(message_no_wild);
  113.         active_tcb^.error_sw := TRUE;
  114.         EXIT;
  115.       END;
  116.  
  117.     (*-----------------------------------------------------------------------*)
  118.     (* Build output file name                                                *)
  119.     (*-----------------------------------------------------------------------*)
  120.  
  121.     cmd_string := this_fsb^.fsb_path + search_arg;
  122.  
  123.     i := file_test(cmd_string);
  124.  
  125.     IF i = 0 THEN
  126.       BEGIN;
  127.         send_message(message_file_exists);
  128.         active_tcb^.error_sw := TRUE;
  129.         EXIT;
  130.       END;
  131.  
  132.     IF i <> 2 THEN
  133.       BEGIN;
  134.         send_tnc_data_str(dos_err_message(i) + cr);
  135.         active_tcb^.error_sw := TRUE;
  136.         EXIT;
  137.       END;
  138.  
  139.     (*-----------------------------------------------------------------------*)
  140.     (* Build temp file name                                                  *)
  141.     (*-----------------------------------------------------------------------*)
  142.  
  143.     in_f := opt_block.msg_file_dir + active_tcb^.port_chan_s + '.IN';
  144.  
  145.     (*-----------------------------------------------------------------------*)
  146.     (* Tell user to start the file                                           *)
  147.     (*-----------------------------------------------------------------------*)
  148.  
  149.     send_message(message_send_the_file);
  150.  
  151.     (*-----------------------------------------------------------------------*)
  152.     (* Receive the file                                                      *)
  153.     (*-----------------------------------------------------------------------*)
  154.  
  155.     in_text_file(in_f, FALSE);
  156.  
  157.     IF active_tcb^.error_sw = TRUE THEN
  158.       EXIT;
  159.  
  160.     (*-----------------------------------------------------------------------*)
  161.     (* Copy file                                                             *)
  162.     (*-----------------------------------------------------------------------*)
  163.  
  164.     cmd_string := copy_file_binary(in_f, cmd_string, FALSE);
  165.  
  166.     (*-----------------------------------------------------------------------*)
  167.     (* Report any errors                                                     *)
  168.     (*-----------------------------------------------------------------------*)
  169.  
  170.     IF cmd_string <> '' THEN
  171.       BEGIN;
  172.         send_tnc_data_str(cmd_string + cr);
  173.         active_tcb^.error_sw := TRUE;
  174.         EXIT;
  175.       END
  176.     ELSE
  177.       send_message(message_file_saved);
  178.  
  179.   END;
  180.  
  181. END.
  182.